home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro5.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.5 KB  |  233 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 5
  27. }
  28. PROGRAM TED_INTRO_NR5;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SCR_OFS        : WORD = 64000 - 12800; { OFSET OF FIRST SCROLLY }
  34.  WATER_OFS      : WORD = 64000 - 12800 + (19*320) +640; { OFSET OF "WATER" SCROLL }
  35. VAR
  36.  BITMAP,WATER   : ARRAY [1..20,0..319] OF BYTE;
  37.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  38.  CHARS          : ARRAY [' '..']'] OF POINTER;
  39.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  40.  F              : FILE;
  41.  B,ROW,NR       : BYTE;
  42.  X,Y,I,J        : INTEGER;
  43.  CH,K           : CHAR;
  44.  TEKST          : STRING;
  45.  SINUS          : ARRAY [0..255] OF BYTE;
  46.  SINN           : BYTE;
  47.  
  48. {───────────────────────────────────────────────────────────────────────────}
  49. PROCEDURE CALCSIN;
  50. VAR I : INTEGER;
  51. BEGIN
  52.  FOR I := 0 TO 255 DO SINUS[I] := ROUND(SIN(5*I*PI/100)*3)+3;
  53. END;
  54. {───────────────────────────────────────────────────────────────────────────}
  55. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  56. ASM
  57.  MOV AX,0013H
  58.  INT 10H
  59. END;
  60. {───────────────────────────────────────────────────────────────────────────}
  61. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  62. ASM
  63.  MOV AX,0003H
  64.  INT 10H
  65. END;
  66. {───────────────────────────────────────────────────────────────────────────}
  67. PROCEDURE VSYNC; ASSEMBLER;
  68. ASM
  69.  MOV DX,03DAH
  70.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  71.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  72. END;
  73. {───────────────────────────────────────────────────────────────────────────}
  74. PROCEDURE DRAWBITMAP; ASSEMBLER;
  75. ASM
  76.  MOV DI,SCR_OFS
  77.  MOV ES,SEGA000
  78.  MOV SI,OFFSET BITMAP
  79.  MOV CX,3200
  80.  CLD
  81.  REP MOVSW
  82. END;
  83. {───────────────────────────────────────────────────────────────────────────}
  84. PROCEDURE DRAWWATER; ASSEMBLER;
  85. ASM
  86.  MOV DI,WATER_OFS
  87.  MOV ES,SEGA000
  88.  MOV SI,OFFSET WATER
  89.  MOV CX,3200
  90.  CLD
  91.  REP MOVSW
  92. END;
  93. {───────────────────────────────────────────────────────────────────────────}
  94. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  95. ASM
  96.   LDS SI,MAP
  97.   LES DI,MAP
  98.   INC SI
  99.   INC SI
  100.   MOV CX,3200
  101.   REP MOVSW
  102. END;
  103. {───────────────────────────────────────────────────────────────────────────}
  104. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  105. ASM
  106.  MOV DX,3C8H
  107.  MOV AL,NR
  108.  OUT DX,AL
  109.  INC DX
  110.  MOV AL,R
  111.  OUT DX,AL
  112.  MOV AL,G
  113.  OUT DX,AL
  114.  MOV AL,B
  115.  OUT DX,AL
  116. END;
  117. {───────────────────────────────────────────────────────────────────────────}
  118. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  119. BEGIN
  120.  ASSIGN(F,NAME+'.PAL');
  121.  RESET(F,1);
  122.  BLOCKREAD(F,PALETTE,768);
  123.  CLOSE(F);
  124.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  125. END;
  126. {───────────────────────────────────────────────────────────────────────────}
  127. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  128. VAR TX,TY: BYTE; CH: CHAR;
  129. BEGIN
  130.  ASSIGN(F,NAME+'.TED');
  131.  RESET(F,1);
  132.  SEEK(F,20);
  133.  WHILE NOT(EOF(F)) DO
  134.  BEGIN
  135.   BLOCKREAD(F,CH,1);
  136.   BLOCKREAD(F,TX,1);
  137.   BLOCKREAD(F,TY,1);
  138.   GETMEM(CHARS[CH],TX*TY);
  139.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  140.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  141.  END;
  142.  CLOSE(F);
  143.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  144.  BEGIN
  145.   TX:=CHARSDATA['A',1];
  146.   TY:=CHARSDATA['A',2];
  147.   GETMEM(CHARS[' '],TX*TY);
  148.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  149.   CHARSDATA[' ',3]:=1;
  150.   CHARSDATA[' ',1]:=TX;
  151.   CHARSDATA[' ',2]:=TY;
  152.  END;
  153. END;
  154. {───────────────────────────────────────────────────────────────────────────}
  155. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  156. VAR CH: CHAR;
  157. BEGIN
  158.  FOR CH:=' ' TO ']' DO
  159.  BEGIN
  160.   IF CHARSDATA[CH,3]=1 THEN
  161.   BEGIN
  162.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  163.    CHARSDATA[CH,3]:=0;
  164.   END;
  165.  END;
  166. END;
  167. {───────────────────────────────────────────────────────────────────────────}
  168. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  169. VAR TX,TY,IC: INTEGER;
  170. BEGIN
  171.  IF CHARSDATA[CH,3]<>1 THEN EXIT; { EXIT IF NO CHAR IN FONT }
  172.  FOR TY:=1 TO 20 DO BITMAP[TY,POS]:=0;
  173.  IC:=0;
  174.  IF RO=CHARSDATA[CH,1]+1 THEN
  175.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY+IC,POS]:=0 { SKIP ONE ROW }
  176.  ELSE
  177.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  178.    BITMAP[TY+IC,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  179. END;
  180. {───────────────────────────────────────────────────────────────────────────}
  181. PROCEDURE UPDATE; { NEW VALUES ? }
  182. BEGIN
  183.  INC(ROW);
  184.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  185.  BEGIN
  186.   ROW:=1;
  187.   INC(NR);
  188.   IF NR>LENGTH(TEKST) THEN NR:=1;
  189.  END;
  190. END;
  191. {───────────────────────────────────────────────────────────────────────────}
  192. PROCEDURE CALCWATER;
  193. VAR Y: INTEGER; DOOD: BYTE;
  194. BEGIN
  195.  FOR Y:=1 TO 20 DO
  196.  BEGIN
  197.   DOOD:=SINUS[Y];
  198.   MOVE(BITMAP[Y],WATER[21-Y,DOOD],320-DOOD);
  199.  END;
  200.  DOOD:=SINUS[0];
  201.  MOVE(SINUS[1],SINUS[0],39);
  202.  SINUS[38]:=DOOD;
  203. END;
  204. {───────────────────────────────────────────────────────────────────────────}
  205.  
  206.  
  207.  
  208. BEGIN
  209.  CALCSIN;
  210.  INITVGA;
  211.  LOADPAL('FONT005');
  212.  LOADTED('FONT005');
  213.  ROW:=1;
  214.  TEKST:='SHIITT... WATTER EFFECT??? EHH..  IF U WANT MAIL ME TO: LIKSAY@BACHUS.UMCS.LUBLIN.PL'+
  215.         ' ,OR CATCH ME ON IRC..    THIS SCROLLY IS FAST ON AT 16MHZ!!                        ';
  216.  NR:=1;
  217.  SINN:=0;
  218.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  219.  FILLCHAR(WATER,SIZEOF(WATER),0);
  220.  REPEAT
  221.   SCROLLBITMAP(BITMAP);
  222.   UPDATE;
  223.   NEWROW(TEKST[NR],ROW,318);
  224.   UPDATE;
  225.   NEWROW(TEKST[NR],ROW,319);
  226.   CALCWATER;
  227.   DRAWBITMAP;
  228.   DRAWWATER;
  229.   VSYNC;
  230.  UNTIL KEYPRESSED;
  231.  DONETED;
  232.  CLOSEVGA;
  233. END.